home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / a_to_d / bigtext / bigtext.pas < prev   
Pascal/Delphi Source File  |  1996-09-15  |  30KB  |  1,048 lines
  1. unit BigText;
  2. { TBigText 1.1  (c) 1995 by Gerry Skolnik (skolnik@kapsch.co.at)
  3.                     Portions (c) 1995 by Danny Thorpe
  4.  
  5.   This is a simple component to display up to 32767 lines of text. Each line
  6.   has its own dedicated foreground and background color and can be 255 chars
  7.   long. Theoretically this amounts to about 8MB of data and beats the TMemo's
  8.   measly 32kB, however, no editing functions are available.
  9.  
  10.   TBigList is a no-frills TList mutant. I've implemented most of the
  11.   essential functions. Before fine-tuning I'd like to wait for Windows 95 /
  12.   Delphi 95, just in case TBigList is made redundant then.
  13.  
  14.   The limitation of TBigText is caused by the Windows API scrolling functions
  15.   insisting on being passed integer values, thus reducing the maximum amount
  16.   of lines a scrollbar can handle to 32767. However, display problems start
  17.   as soon as line 32750. As I couldn't see much difference between 32750 and
  18.   32767 lines, I haven't bothered to track this down. Be my guest.
  19.  
  20.   TBigText is FreeWare. You may use it freely at your own risk in any
  21.   kind of environment. This component is not to be sold at any charge, and
  22.   must be distributed along with the source code.
  23.  
  24.   The scrolling routines were taken from Danny Thorpe's TConsole object.
  25.  
  26.   BTW: while I claim the copyright to the original source code, this does
  27.   not mean that you may not modify or enhance it. Just add your credits,
  28.   and if you think you came up with some major improvement that the Delphi
  29.   community might find useful, upload it at some Delphi site.
  30.   Of course, any enhancement/modification must be released as Freeware.
  31.  
  32.   property MaxLines
  33.            if set to 0, as much lines as memory permits are included. The
  34.            absolute maximum, however, is 32767. If set to something else,
  35.            TBigText will limit itself to that many lines.
  36.  
  37.   property PurgeLines
  38.            determines how to handle the situation when no more lines can be
  39.            added (line count reached Maxlines value or we ran out of memory).
  40.            if set to 0, an exception is raised. If set to something different
  41.            (default 200) the number of lines specified by PurgeLines are
  42.            deleted, the TBigList objects are packed, and most likely more
  43.            lines can be added (though the first ones will be lost).
  44.            This option is useful for logging windows.
  45.  
  46.   property Count
  47.            run-time read-only. If the Lines and StringColor counts
  48.            are equal, this property holds the number of lines in TBigText.
  49.            If the two counts are unequal, there's something wrong and the
  50.            property holds a value of -1.
  51.  
  52.   procedure AddLine(LineString: string; FCol, BCol: TColor;
  53.             UpdateDisplay: boolean);
  54.            The essential routine to insert lines into TBigText.
  55.            LineString   : the text to be inserted
  56.            FCol         : forground color
  57.            BCol         : background color
  58.            UpdateDisplay: if true, TBigText will scroll to the last line
  59.                           (where the new line will be added), and update
  60.                           its display. This is not recommended if lots of
  61.                           lines are to be included in a loop.
  62.  
  63.   procedure LoadFromFile(FileName: TFileName);
  64.            Loads a file into TBigText. Every line will have the default colors
  65.            clWindowText, clWindow.
  66.  
  67.   procedure Print
  68.            prints all lines on the specified printer. Haven't
  69.            checked this out, though.
  70.  
  71.   procedure ChangeColor(Index: longint; OldFCol, OldBCol, NewFCol,
  72.            NewBCol: TColor);
  73.            changes the colors of the line at Index, but only if the
  74.            current colors match OldFCol and
  75.            OldBCol (FCol = foreground color, BCol = background color).
  76.  
  77.   the following procedures do pretty much the same as
  78.            the accodring TList methods:
  79.  
  80.            procedure Clear;
  81.            procedure Delete(Index: longint);
  82.            procedure Remove(Index: longint);
  83.            procedure Pack;
  84.  
  85.  
  86. *****************************************************************
  87. Function Search - Added EJH 07/04/95
  88. Search('this text', True, True);
  89. Parameters:
  90.       SrcWord  : String - What to Look for in the array
  91.       SrchDown : Bool - True - Search down; False - Search Up
  92.       MCase    : Bool - True - Match Case Exact; False - Disregard Case
  93.  
  94. Returns:       True - Found ; False - Not Found
  95.  
  96.       Note: This is a little screwy because it does not redisplay the
  97.             last page if text is found there when already on the last page.
  98.             Also, during displays of found data, on the last call, if the
  99.             user closes the finddialog, I could not see an automatic way
  100.             for this application to know that it was not visible, so the
  101.             final blue line stays on the screen untill the window scrolls
  102.             beyond it, from then on it is not there.  This is sometimes
  103.             useful, othertimes it is just ugly.
  104.  
  105.       Note: To find exact matches if you have the option available to the
  106.             user, put a space on both sides of SrcWord, otherwise partial
  107.             matches are used.
  108.  
  109. Modifications - Eric Heverly - July 1995 (erichev@ix.netcom.com)
  110.  
  111.        Scroll- Added keys F1-F4 to the Scrool Keys table.
  112.        Print - Added canvas font for the display canvas to the printer
  113.                so the expected printer font was the same.  Also added some
  114.                Cursor := crHourGlass to show that the system was busy during
  115.                print cycles.
  116.        Search- Added function.
  117.        GoPosi- GoPosition function added.
  118.        LoadFr- LoadFromFile added some Cursor := crHourGlass to show the
  119.                user that the system is busy.  Also I changed the call to the
  120.                addline function to use the dumchar, this keeps the font to
  121.                the defined font in the object editor (ie. I used Courier and
  122.                this way it kept Courier as the display font, with the OEM
  123.                characters, it always used the System font).
  124.  
  125. }
  126. interface
  127.  
  128. uses WinTypes, WinProcs, Messages, Classes, Controls, Printers,
  129.      Forms, Graphics, SysUtils;
  130.  
  131. type
  132.   {$M+}
  133.   TStringColor = class
  134.   public
  135.     FColor : TColor;
  136.     BColor : TColor;
  137.   end;
  138.   TBigList = class
  139.  
  140.     private
  141.     function GetCapacity: longint;
  142.     function GetCount: longint;
  143.     function GetItems(Index: longint): pointer;
  144.     procedure SetItems(Index: longint; const Item: pointer);
  145.   protected
  146.     ListCount : LongInt;
  147.     TheLines  : array[0..3] of TList;
  148.   published
  149.     property Capacity: longint read GetCapacity;
  150.     property Count: longint read GetCount;
  151.   public
  152.     property Items[Index: longint]: pointer read GetItems write SetItems;
  153.     constructor Create;
  154.     destructor Destroy;
  155.     class function ClassName: string;
  156.     function Add(Item: Pointer): longint;
  157.     procedure Delete(Index: longint);
  158.     procedure Remove(Index: longint);
  159.     procedure Pack;
  160.     procedure Clear;
  161.     function First: pointer;
  162.     function Last: pointer;
  163.   end;
  164.   {$M-}
  165.   TBigText = class(TCustomControl)
  166.   private
  167.     FFont: TFont;
  168.     FMaxLines: word;
  169.     FPurgeLines: word;
  170.     FColor : TColor;
  171.     procedure DoScroll(Which, Action, Thumb: LongInt);
  172.     procedure WMHScroll(var M: TWMHScroll); message wm_HScroll;
  173.     procedure WMVScroll(var M: TWMVScroll); message wm_VScroll;
  174.     procedure WMSize(var M: TWMSize); message wm_Size;
  175.     procedure WMGetDlgCode(var M: TWMGetDlgCode); message wm_GetDlgCode;
  176.     procedure SetFont(F: TFont);
  177.     function GetCount: longint;
  178.   protected
  179.     FRange: TPoint;
  180.     FOrigin: TPoint;
  181.     FClientSize: TPoint;
  182.     FCharSize: TPoint;
  183.     FOverhang: LongInt;
  184.     FPageSize: LongInt;
  185.     Lines: TBigList;
  186.     StringColor: TBigList;
  187.     procedure Paint; override;
  188.     procedure SetScrollbars;
  189.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  190.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  191.                 X, Y: Integer); override;
  192.   published
  193.     proced